home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d27
/
dsprcdfm.arc
/
CPP1520.RPG
next >
Wrap
Text File
|
1991-12-04
|
6KB
|
143 lines
F/TITLE DISPLAY A FILE'S RECORD FORMAT
F* PROGRAM NAME - CPP1520
F* CPP FOR COMMAND - DSPRCDFMT
F*
FCPP1520 CF E WORKSTN KINFDS WSDS
F RRN KSFILE CPP1520D
FQADSPFFDIF E DISK UC
E FL 21 1 FILENAME WORK ARR
E D 80 160 1 DSPFFD COMMAND
IFILE DS
I 1 10 FNAME
I 11 20 FLIB
IWSDS DS
I B 378 3790SFREC
C *ENTRY PLIST
C PARM FILE
C/SPACE
C* BUILD FILE NAME FOR CALL TO QCAEXEC
C MOVEAFNAME FL,1
C Z-ADD1 X 50
C ' ' LOKUPFL,X 98
C MOVE '.' FL,X
C ADD 1 X
C MOVEAFLIB FL,X
C* PLACE FILE,LIBRARY NAME INTO DSPFFD COMMAND ARRAY
C MOVEAFL D,11
C* EXECUTE THE DSPFFD COMMAND VIA QCAEXEC
C MOVEAD CMD 80
C CALL 'QCAEXEC' 97 IF 97 RETURN
C PARM CMD
C PARM 80 LENGTH 155
C/SPACE
C* IF AND ERROR OCCURED WHILE EXECUTING THE
C* DSPFFD COMMAND, THEN RETURN TO THE CALLER
C *IN97 CABEQ'1' EXIT
C/SPACE
C* SET ON FIRST CALL FLAG
C MOVEL'1' FIRST 1
C* EXECUTE OVERRIDE DATABASE FILE COMMAND
C MOVEAD,81 CMD
C EXSR EXECMD
C/SPACE
C* OPEN THE WORKFILE
C OPEN QADSPFFD 97 IF 97 RETURN
C/SPACE
C* IF AND ERROR OCCURED DURING OPEN
C* THEN RETURN TO THE CALLER
C *IN97 CABEQ'1' EXIT
C/SPACE
C* ACTIVATE THE SUBFILE FILE
C* (NOTE AT HIS POINT *IN21 IS EQUAL TO ZERO)
C CLRSFL TAG
C MOVEL'0' *IN21
C WRITECPP1520C
C Z-ADD0 RRN 50
C/SPACE
C* READ WORKFILE AND FILL UP SUBFILE
C READWF TAG
C READ QADSPFFD 96EOF = 96
C *IN96 IFEQ '0'
C MOVEL'0' *IN05
C FIRST IFEQ '1'
C MOVELWHNAME LSTRCD
C END
C* COMPARE THIS RECORD FORMAT TO THE LAST FORMAT.
C* IF THE RECORD FORMATS MATCH THEN PROCESS RECORD.
C WHNAME IFEQ LSTRCD
C MOVEL'0' FIRST
C* BUILD FIELD FROM-TO POSITIONS
C WHIBO ADD WHFLDB FLDTO
C SUB 1 FLDTO
C Z-ADDWHIBO FLDFRM
C* BUILD FIELD LENGTH ATTRIBUTE
C WHFLDT IFEQ 'A'
C MOVE WHFLDB LEN
C ELSE
C MOVELWHFLDD LEN
C MOVE ' ' LEN
C MOVE WHFLDP LEN
C END
C* INCREMENT SUBFILE RELATIVE RECORD NUMBER
C ADD 1 RRN
C* WRITE SUBFILE RECORD
C WRITECPP1520D
C* BRANCH BACK TO READ
C GOTO READWF
C ELSE
C MOVELWHNAME LSTRCD
C READPQADSPFFD 9898
C *LIKE DEFN WHNAME LSTRCD
C END
C END
C/SPACE
C* IF NO SUBFILE RECORDS HAVE BEEN WRITTEN,
C* THEN RETURN TO THE CALLER
C RRN CABLT1 EXIT
C/SPACE
C* DISPLAY THE SUBFILE CONTROL RECORD
C* SUBFILE IS CONTROLLED BY INDICATOR 21
C MOVEL'1' *IN21
C* FILE FIELD INFORMATION WILL BE DISPLAYED UNTIL
C* COMMAND KEY 1 IS PRESSED
C Z-ADD1 RECNO
C *IN01 DOUEQ'1'
C DSPSFL TAG
C WRITECPP1520B
C EXFMTCPP1520C
C Z-ADDSFREC RECNO
C *IN05 CABEQ'1' CLRSFL
C MOVE '0' *IN93
C READC TAG
C READCCPP1520D 93
C *IN93 IFEQ '0'
C OPT IFEQ '1'
C MOVEL' ' OPT
C UPDATCPP1520D
C EXFMTCPP1520I
C *IN01 CABEQ'1' EXIT
C *IN02 CABEQ'1' DSPSFL
C END
C OPT IFEQ '5'
C MOVEL' ' OPT
C UPDATCPP1520D
C MOVEL*BLANKS CMD
C MOVEL'DSPFLDWU'CMD 80
C MOVE WHFLDE CMD
C EXSR EXECMD
C END
C GOTO READC
C END
C END
C EXIT TAG
C MOVEL'1' *INLR
CSR EXECMD BEGSR
C* EXECUTE THE COMMAND STRING
C CALL 'QCAEXEC'
C PARM CMD
C PARM 80 LENGTH
CSR ENDSR
**
DSPFFD OUTPUT(*NONE) OUTFILE(QADSPFFD.QTEMP)
OVRDBF QADSPFFD TOFILE(QADSPFFD.QTEMP)